package ChessLike::Board;
use strict;
use warnings;

=head1 NAME

ChessLike::Board - The great new ChessLike::Board!

=head1 VERSION

Version 0.0.1

=cut

use version; our $VERSION = qv("v0.0.1");

use ChessLike::GamePiece;
use ChessLike::Action;
use Config::General qw( ParseConfig );
use Bit::Vector;

=head1 SYNOPSIS

Quick summary of what the module does.

Perhaps a little code snippet.

    use ChessLike::Board;

    my $foo = ChessLike::Board->new();
    ...

=head1 EXPORT

A list of functions that can be exported.  You can delete this section
if you don't export anything, such as for a purely object-oriented module.

=head1 API

=head2 new( $class, `x-tiles' => $x, `y-tiles' => $y )

 Purpose: Creates a new game board
 Options: `x-tiles' - Number of tiles in X dimension (default = 8)
          `y-tiles' - Number of tiles in Y dimension (default = 8)
 Returns: $self
 Throws: Dies if either $x or $y is not an integer.

=cut

sub new {
   my ( $class, %options ) = @_;

   my $self = {
      'x-tiles'  => 8,
      'y-tiles'  => 8,

      'contents-gamepieces' => [],
      'contents-teams'      => [],
      'contents-directions' => [],
      'contents-graphics'   => [],

      'move-graphic-hook'   => sub {},
      'delete-graphic-hook' => sub {},
      'rotate-graphic-hook' => sub {},
      
      'actions-cache-for'     => 'none',
      'legal-actions-cache'   => [],
      'illegal-actions-cache' => [],
      'movement-space-cache'  => undef,

      'carrier-cache' => {},
      'flier-cache' => {},
      'dock-cache' => {},

      # There are two ways to fill these bitvectors:
      # 1) During calculate_actions(), if the array is empty
      # 2) After applying any action
      'flier-location-bitvectors' => [],
   };

   foreach ( 'x-tiles', 'y-tiles' ) {
      my $n = $options{$_};
      next if ( !defined $n );

      die "ERROR: Board dimension $n is not an integer.\n"
         if ( $n !~ m{\A[1-9][0-9]*\z} );

      $self->{$_} = $n;
   }

   return bless $self, $class;
}

=head2 parse( $class, $board_config_path, $gamepiece_config_dirpath )

 Purpose: Creates a new game board using configuration found at
          $board_config_path.  Game pieces will be constructed
          automatically using config files found in $gamepiece_config_dirpath.
 Returns: $self
 Throws: none

=cut

sub parse {
   my ( $class, $board_config_path, $gamepiece_config_dirpath ) = @_;
   my %config = ParseConfig( $board_config_path );
   $gamepiece_config_dirpath .= '/'
      if ( $gamepiece_config_dirpath !~ m{ \/ \z}x );

   foreach ( 'x-tiles', 'y-tiles' ) {
      my $option = $config{$_};
      next if ( !defined $option );

      # If user has entered multiple values, keep only the last one
      $config{$_} = $option->[-1] if ( ref $option eq 'ARRAY' );
   }

   # Create our board
   my $self = $class->new( %config );

   # Now we populate our board with game pieces.  We keep a cache of
   # game piece objects, since we only need one copy of each, regardless
   # of how many pieces there are.
   my %gamepiece_cache;

   my %direction_for_team = (
      1 => 'n',
      2 => 's',
      );

   foreach my $player ( 'player1', 'player2' ) {
      my $player_config = $config{$player};
      my ( $team ) = ( $player =~ m{ player ( \d ) }x );
      
      foreach my $tile ( sort keys %{ $player_config } ) {
         # Ensure that single vectors are packaged into an array
         my @gamepiece_names = ( ref $player_config->{$tile} eq 'ARRAY' )
            ? @{ $player_config->{$tile} } : ( $player_config->{$tile} );

         foreach my $gamepiece_name ( @gamepiece_names ) {
            my $gamepiece = $gamepiece_cache{$gamepiece_name};

            if ( !defined $gamepiece ) {
               my $gamepiece_config
                  = "$gamepiece_config_dirpath$gamepiece_name" . '.cfg';
               die "Config file $gamepiece_config not found!\n"
                  unless (-e $gamepiece_config);

               if ( -e $gamepiece_config ) {
                  $gamepiece
                     = ChessLike::GamePiece->parse( $gamepiece_config );
                  $gamepiece_cache{$gamepiece_name} = $gamepiece;
               }
            }

            $self->add( $tile,
               'gamepiece' => $gamepiece,
               'team' => $team,
               'direction' => $direction_for_team{$team},
               );
         }
      }
   }

   return $self;
}

=head2 x_tiles()

 Purpose: Returns number of tiles in the X dimension of the board.
 Returns: $n_tiles
 Throws: none

=cut

sub x_tiles { return shift->{'x-tiles'} }

=head2 y_tiles()

 Purpose: Returns number of tiles in the Y dimension of the board.
 Returns: $n_tiles
 Throws: none

=cut

sub y_tiles { return shift->{'y-tiles'} }

=head2 set_move_graphic_hook()

 Purpose: Set the graphics function to be called when a gamepiece is moved.
 Returns: 1
 Throws: 

=cut

sub set_move_graphic_hook {
    my ( $self, $sub ) = @_;
    
    # TODO: Check that $sub is a SUB
    
    $self->{'move-graphic-hook'} = $sub;
    return 1;
}

=head2 set_delete_graphic_hook()

 Purpose: Set the graphics function to be called when a gamepiece is destroyed.
 Returns: 1
 Throws: 

=cut

sub set_delete_graphic_hook {
    my ( $self, $sub ) = @_;

    # TODO: Check that $sub is a SUB
    
    $self->{'delete-graphic-hook'} = $sub;
    return 1;
}

=head2 set_rotate_graphic_hook()

 Purpose: Set the graphics function to be called when a gamepiece is rotated.
 Returns: 1
 Throws: 

=cut

sub set_rotate_graphic_hook {
    my ( $self, $sub ) = @_;

    # TODO: Check that $sub is a SUB
    
    $self->{'rotate-graphic-hook'} = $sub;
    return 1;
}

=head2 get_tile_contents( $tile, @desired_arrayrefs )

 Purpose: Returns array references for requested tile contents.  Accepts
          `gamepieces', `teams', `directions', and `graphics'.
 Returns: @requested_array_references, if multiple arrays are requested.
          $requested_arrayref, if a single array is requested.
 Throws: none

=cut

sub get_tile_contents {
   my ( $self, $tile, @keys ) = @_;
   my $tile_id = $self->convert( $tile, 'id' );

   my %arrayref_for = (
      'gamepieces' => $self->{'contents-gamepieces'}->[$tile_id],
      'teams' => $self->{'contents-teams'}->[$tile_id],
      'directions' => $self->{'contents-directions'}->[$tile_id],
      'graphics' => $self->{'contents-graphics'}->[$tile_id],
      );

   # Returning the array references directly allows for abuse of the API,
   # so we make a copy first.  We also define any arrays that haven't been
   # created yet.
   my @results = map {
        my @copy = defined $_ ? @{$_} : ();
        \@copy;
    } @arrayref_for{ @keys };
   
   return ( @results == 1 ) ? $results[0] : @results;
}

=head2 get_tile_contents_for_index( $tile, $index, @desired_values )

 Purpose: Returns values for requested tile index contents.  Accepts
          `gamepiece', `team', `direction', and `graphic'.
 Returns: @requested_scalars, if multiple values are requested.
          $requested_scalar, if a single value is requested.
 Throws: none

=cut

sub get_tile_contents_for_index {
   my ( $self, $tile, $index, @keys ) = @_;
   my $tile_id = $self->convert( $tile, 'id' );

   my %arrayref_for = (
      'gamepiece' => $self->{'contents-gamepieces'}->[$tile_id]->[$index],
      'team' => $self->{'contents-teams'}->[$tile_id]->[$index],
      'direction' => $self->{'contents-directions'}->[$tile_id]->[$index],
      'graphic' => $self->{'contents-graphics'}->[$tile_id]->[$index],
      );

   my @results = map { defined $_ ? $_ : [] } @arrayref_for{ @keys };
   return ( @results == 1 ) ? $results[0] : @results;
}

=head2 add( $tile, %options )

 Purpose: Adds a new game piece to $tile_id.
 Returns: $index
 Options: `gamepiece' - An instance of ChessLike::GamePiece
          `direction' - Compass direction that gamepiece is facing (n,s,e,w)
          `team' - Team that the gamepiece belongs to
          `graphic' - Convenient storage for graphical representation of the
                      gamepiece. Unrestricted by this class.
 Throws: Dies if `gamepiece' is not an instance of ChessLike::GamePiece.
         Dies if `team' is non-numeric.
 Comments: As a convenience, ground units are prepended to the beginning of
           the tile's content arrays, and flying units are appended at the
           end.

=cut

sub add {
   my ( $self, $tile, %options ) = @_;
   my $tile_id = $self->convert( $tile, 'id' );
   my ( $gamepiece, $direction, $team, $graphic )
      = @options{ 'gamepiece', 'direction', 'team', 'graphic' };

   die "Game piece $gamepiece is not an instance of"
       . " ChessLike::GamePiece.\n"
      if ( ref( $gamepiece ) ne 'ChessLike::GamePiece' );
   die "Team $team is non-numeric.\n" if ( $team =~ m{\D} );

   my $is_flying = $gamepiece->is_flying();

   my %add_as = (
      1 => sub {
          my $ref = shift;
          push @{ $ref->[$tile_id] }, shift;
      },
      0 => sub {
          my $ref = shift;
          unshift @{ $ref->[$tile_id] }, shift;
      },
  );

   $add_as{ $is_flying }->(
       $self->{'contents-gamepieces'}, $gamepiece );
   $add_as{ $is_flying }->(
       $self->{'contents-teams'}, $team );
   $add_as{ $is_flying }->(
       $self->{'contents-directions'}, $direction );
   $add_as{ $is_flying }->(
       $self->{'contents-graphics'}, $graphic );
   
   my $contents_gamepieces_ref
       = $self->{'contents-gamepieces'}->[$tile_id];
   
   my $index = $is_flying
      ? $#{ $contents_gamepieces_ref } : 0;
   
   # If $index is 0, then we may be affecting elements of
   # carrier-cache, flier-cache, and dock-cache.
   if ( $index == 0 && @{ $contents_gamepieces_ref } > 1 ) {
       $self->update_cached_indices( $tile_id, $index, 1 );
   }
   
   # Remember any carriers and fliers for later use
   my $carries_units = $gamepiece->carries_units();
   if ( defined $carries_units ) {
      my $name = $gamepiece->name();
      my $bitvector = $self->calculate_carrier_airspace(
         $gamepiece, $direction, $tile_id );
      
      $self->{'carrier-cache'}->{"$name-$team"}->{"$tile_id.$index"}
         = $bitvector;
   }
   
   # TODO: There's a bug here.  Dock status should be calculated whether
   # a flier OR carrier move, not just a flier.  Also, this should be
   # factored out, so that we can call it from remove() as well.
   
   my $requires_units = $gamepiece->requires_units();
   if ( defined $requires_units ) {
       # Record flier location in cache
       my $name = $gamepiece->name();
       my $bitvector = $self->convert( $tile_id, 'bitvector' );
       $self->{'flier-cache'}->{"$name-$team"}->{"$tile_id.$index"}
           = $bitvector;
       
       # Record dock status in cache
       my $gamepieces_ref = $self->get_tile_contents(
           $tile_id, 'gamepieces' );
       for ( my $carrier_index = 0;
             $carrier_index <= $#{$gamepieces_ref};
             $carrier_index++ ) {
           
           next if ( $gamepieces_ref->[$carrier_index]->name()
                         ne $requires_units );
           
           my $carrier_team = $self->get_tile_contents_for_index(
               $tile_id, $carrier_index, 'team' );
           next if ( $carrier_team != $team );
           
           if ( !defined $self->{'dock-cache'}->{
                "$tile_id.$carrier_index"} ) {
               
               $self->{'dock-cache'}->{"$tile_id.$carrier_index"}
                   = "$tile_id.$index";
               $self->{'dock-cache'}->{"$tile_id.$index"}
                   = "$tile_id.$carrier_index";
               last;
           }
       }
   }
   
   # Board changed, so forget actions cache
   $self->forget_actions_cache();
   
   return $index;
}

=head2 configure( $tile, $index, %options )

 Purpose: Configure game piece configuration on board.
 Returns: 1
 Options: `gamepiece' - An instance of ChessLike::GamePiece
          `direction' - Compass direction that gamepiece is facing (n,s,e,w)
          `team' - Team that the gamepiece belongs to
          `graphic' - Convenient storage for graphical representation of the
                      gamepiece. Unrestricted by this class.
 Throws: Dies if `gamepiece' is not an instance of ChessLike::GamePiece.
         Dies if `team' is non-numeric.

=cut

sub configure {
   my ( $self, $tile, $index, %options ) = @_;
   my $tile_id = $self->convert( $tile, 'id' );
   my ( $gamepiece, $team ) = @options{ 'gamepiece', 'team' };

   if ( exists $options{'gamepiece'} ) {
      die "Game piece $gamepiece is not an instance of ChessLike::GamePiece.\n"
         if ( ref( $gamepiece ) ne 'ChessLike::GamePiece' );
   }
   if ( exists $options{'team'} ) {
      die "Team $team is non-numeric.\n" if ( $team =~ m{\D} );
   }

   foreach my $key ( 'gamepiece', 'direction', 'team', 'graphic' ) {
      if ( exists $options{$key} ) {
         $self->{"contents-$key".'s'}->[$tile_id]->[$index] = $options{$key};
      }
   }

   ## TODO: See what changes need to be made to support 'carrier-locations'
   
   # Board changed, so forget actions cache
   $self->forget_actions_cache();

   return 1;
}

=head2 remove( $tile, $index )

 Purpose: Removes the gamepiece at $index from $tile.
 Returns: 1
 Throws: Dies if gamepiece does not exist at $tile and $index

=cut

sub remove {
   my ( $self, $tile, $index ) = @_;

   my $tile_id = $self->convert( $tile, 'id' );
   my $gamepiece = splice(
      @{ $self->{'contents-gamepieces'}->[$tile_id] }, $index, 1 );

   die "Gamepiece does not exist at tile [$tile] and index [$index].\n"
      if ( !defined $gamepiece );

   my $team = splice(
      @{ $self->{'contents-teams'}->[$tile_id] }, $index, 1 );

   foreach ( 'directions', 'graphics' ) {
      splice( @{ $self->{"contents-$_"}->[$tile_id] }, $index, 1 );
   }
   
   # Clear cache entry if unit is a carrier- or flier-type
   my $carries_units = $gamepiece->carries_units();
   if ( defined $carries_units ) {
      my $name = $gamepiece->name();
      delete ${ $self->{'carrier-cache'}->{"$name-$team"} }{"$tile_id.$index"};
   }

   my $requires_units = $gamepiece->requires_units();
   if ( defined $requires_units ) {
      my $name = $gamepiece->name();
      
      delete ${ $self->{'flier-cache'}->{"$name-$team"} }{"$tile_id.$index"};
      
      if ( defined $self->{'dock-cache'}->{"$tile_id.$index"} ) {
          my $carrier_location = delete
              $self->{'dock-cache'}->{"$tile_id.$index"};
          delete $self->{'dock-cache'}->{$carrier_location};
      }
   }

   my $contents_gamepieces_ref
       = $self->{'contents-gamepieces'}->[$tile_id];

   # If $index is not the final element, then we may be affecting
   # elements of carrier-cache, flier-cache, and dock-cache.
   if ( $index <= $#{ $contents_gamepieces_ref }
            && @{ $contents_gamepieces_ref } > 0 ) {

       $self->update_cached_indices( $tile_id, $index, -1 );
   }
   
   # Board changed, so forget actions cache
   $self->forget_actions_cache();

   return 1;
}

## update_cached_indices
#
# Purpose: add() and remove() can affect the carrier-cache, flier-cache,
#          and dock-cache.  This method makes the necesary updates.
# Returns: 1
# Throws: none
# Comment: This is an internal method that is expected to bbe called
#          only from add() orremove()

sub update_cached_indices {
    my ( $self, $tile_id, $index, $adjustment ) = @_;

    my $contents_gamepieces_ref = $self->{'contents-gamepieces'}->[$tile_id];
    my $contents_teams_ref = $self->{'contents-teams'}->[$tile_id];
    my %dock_cache_changes;
    my $new_cache_index;

    my %for_conditions = (
        # When called from add(), we go from highest index to lowest
        # so that we don't accidently clobber any cached values when
        # we add +1 to the cached index.
        'start1' => $#{ $contents_gamepieces_ref },
        'loop1' => sub { return shift( @_ ) > 0; },
        'end1' => sub { my $ref = shift( @_ );
                        ${ $ref }--; },

        # When called from remove(), we go from lowest index to highest
        # so that we don't accidently clobber any cached values when we
        # subtract 1 from the cached index.
        'start-1' => $index,
        'loop-1' => sub { return shift( @_ ) <= $#{ $contents_gamepieces_ref }; },
        'end-1' => sub { my $ref = shift( @_ );
                         $ { $ref }++; },
    );

    for ( $new_cache_index = $for_conditions{"start$adjustment"};
          $for_conditions{"loop$adjustment"}->( $new_cache_index );
          $for_conditions{"end$adjustment"}->( \$new_cache_index ) ) {

        my $old_cache_index = $new_cache_index - $adjustment;
        my $unit_name = $contents_gamepieces_ref->[$new_cache_index]->name();
        my $unit_team = $contents_teams_ref->[$new_cache_index];
        
        foreach my $cache ( 'carrier-cache', 'flier-cache' ) {
            my $location_ref = $self->{$cache}->{"$unit_name-$unit_team"};
            
            if ( defined $location_ref ) {
                my $unit_bitvector = $location_ref->{"$tile_id.$old_cache_index"};

                if ( defined $unit_bitvector ) {
                    $location_ref->{"$tile_id.$new_cache_index"}
                        = $unit_bitvector;
                    delete $location_ref->{"$tile_id.$old_cache_index"};
                }
            }
        }

        my $dock_pair = $self->{'dock-cache'}->{"$tile_id.$old_cache_index"};
        if ( defined $dock_pair ) {
            my ( $paired_tile, $paired_index )
                = split m{\.}, $dock_pair, 2;
            if ( $paired_index >= $index ) {
                $paired_index += $adjustment;
            }
            
            $dock_cache_changes{"$tile_id.$new_cache_index"}
                = "$paired_tile.$paired_index";
            delete $self->{'dock-cache'}->{"$tile_id.$old_cache_index"};
            delete $self->{'dock-cache'}->{$dock_pair};
        }
    }

    foreach my $dock ( keys %dock_cache_changes ) {
        my $dock_pair = $dock_cache_changes{$dock};
        $self->{'dock-cache'}->{$dock} = $dock_pair;
        $self->{'dock-cache'}->{$dock_pair} = $dock;
    }

    return 1;
}

=head2 move( $tile, $index, $target_tile )

 Purpose: Moves the gamepiece at $index from $tile to $target_tile.
 Returns: $new_index
 Throws: none
 Comment: A convenience method that is equivalent to calling add() and
          remove() on the gamepiece.
 Comment: As with add(), ground units are prepended to the beginning of
          the target tile's content arrays, and flying units are appended at
          the end.

=cut

sub move {
   my ( $self, $tile, $index, $target ) = @_;

   my ( $gamepiece, $team, $direction, $graphic )
      = $self->get_tile_contents_for_index( $tile, $index,
      'gamepiece', 'team', 'direction', 'graphic' );

   $self->remove( $tile, $index );

   my $new_index = $self->add( $target,
      'gamepiece' => $gamepiece,
      'team' => $team,
      'direction' => $direction,
      'graphic' => $graphic,
      );
      
      # Don't need to forget actions-cache, since add()
      # and remove() do it for us.

   return $new_index;
}

#### forget_actions_cache()
##
## Purpose: Flags action and proxy space caches as out-of-date
## Returns: 1
## Throws: none
## Comments: Intended for internal use only.
   
sub forget_actions_cache {
    shift->{'actions-cache-for'} = 'none';
    return 1;
}

#### calculate_carrier_airspace( $gamepiece, $direction, $tile )
##
## Purpose: Calculates a bit vector describing controlled airspace.
## Returns: $airspace_bitvector
## Throws: none
## Comment: Intended for internal use only.

sub calculate_carrier_airspace {
   my ( $self, $carrier, $direction, $carrier_tile ) = @_;
   my ( $x_tiles, $y_tiles )
       = ( $self->x_tiles(), $self->y_tiles() );
   my @proxy_field = @{ $carrier->proxy_move_field() };

   my $airspace = Bit::Vector->new( $x_tiles*$y_tiles );

   my %field_transform_for_direction = (
         'n' => sub { return @_; },
         'e' => sub {
                  my ( $width, $height, $mid_x,
                       $mid_y ) = @_;
                  return ( $height, $width, $mid_y,
                           $width-($mid_x-1) );
                },
         's' => sub {
                  my ( $width, $height, $mid_x,
                       $mid_y ) = @_;
                  return ( $width, $height,
                           $width-($mid_x-1),
                           $height-($mid_y-1) );
                },
         'w' => sub {
                  my ( $width, $height, $mid_x,
                       $mid_y ) = @_;
                  return ( $height, $width,
                           $height-($mid_y-1),
                           $mid_x );
                },
     );

   my ( $field_x, $field_y, $midpoint_x, $midpoint_y )
      = $field_transform_for_direction{$direction}->( @proxy_field );

   my ( $carrier_x, $carrier_y )
      = split m{,}, $self->convert( $carrier_tile, 'xy' ), 2;

   CARRIER_COLUMN:
   for ( my $col = 0; $col < $field_x; $col++ ) {
      my $corrected_col = $carrier_x - $midpoint_x + $col + 1;

      next CARRIER_COLUMN if ( $corrected_col < 1 );
      next CARRIER_COLUMN if ( $corrected_col > $x_tiles );

      CARRIER_ROW:
      for ( my $row = 0; $row < $field_y; $row++ ) {
         my $corrected_row = $carrier_y - $midpoint_y + $row + 1;

         next CARRIER_ROW if ( $corrected_row < 1 );
         next CARRIER_ROW if ( $corrected_row > $y_tiles );
         
         my $corrected_tile_id = $self->convert(
            "$corrected_col,$corrected_row", 'id' );

         # Build the field
         $airspace->Bit_On( $corrected_tile_id );
      }
   }
   
   return $airspace;
}

## get_carrier_indices_containing_tile( $tile_id, @carrier_bitvectors )
#
# Purpose: For a given array of bitvectors, calculates which indices
#          contain $tile_id.
# Returns: @carrier_indices
# Throws: none

sub get_carrier_indices_containing_tile {
    my ( $self, $tile_id, @carrier_bitvectors ) = @_;
    my ( $x_tiles, $y_tiles ) = ( $self->x_tiles(), $self->y_tiles() );
    my $tile_bitvector = $self->convert( $tile_id, 'bitvector' );

    my @carrier_indices;
    my $index = 0;

    foreach my $carrier_bitvector ( @carrier_bitvectors ) {
        my $test_vec = Bit::Vector->new( $x_tiles*$y_tiles );
        $test_vec->And( $carrier_bitvector, $tile_bitvector );
        my $test_string = $test_vec->to_Bin();

        if ( $test_string != 0 ) {
            push @carrier_indices, $index;
        }
        
        $index++;
    }

    return @carrier_indices;
}


## get_fliers_linked_to_carrier( $carrier_tile, $carrier_index, $return_as_bitvectors [optional] )
#
# Purpose: Returns a list of all fliers that are
#          linked solely to the carrier
#          of interest, and a list of all fliers
#          that are linked to this, and
#          at least one other carrier.
# Returns: \@linked_fliers, \@tentatively_linked_fliers
#          or $linked_bv, $tentatively_linked_bv
#          If unit is not a carrier, returns ([], [])
#          or (undef, undef)
# Throws: none

sub get_fliers_linked_to_carrier {
    my ( $self, $carrier_tile, $carrier_index,
         $return_bitvectors ) = @_;
    my $carrier_tile_id
        = $self->convert( $carrier_tile, 'id' );
    
    # Board info
    my ( $x_tiles, $y_tiles )
        = ( $self->x_tiles(), $self->y_tiles() );
    my ( $team, $carrier )
        = $self->get_tile_contents_for_index(
            $carrier_tile_id, $carrier_index,
            'team', 'gamepiece' );
    
    # Gamepiece info
    
    my $carrier_name = $carrier->name();
    my $flier_name   = $carrier->carries_units();
    
    # Bail if unit is not a carrier
    if ( !defined $flier_name ) {
        ( $return_bitvectors ) ? return ( undef, undef )
            : return ( [], [] ) ;
    }
    
    # Bitvectors
    my %bitvector_for_carrier_location
        = %{ $self->{'carrier-cache'}->{"$carrier_name-$team"} };
    my %bitvector_for_flier_location
        = %{ $self->{'flier-cache'}->{"$flier_name-$team"} };
    
    # Create a list containing all other carriers of
    # the same team and type
    my $carrier_bitvector = delete
        $bitvector_for_carrier_location{
            "$carrier_tile_id.$carrier_index" };
    my @carrier_bitvectors = (
        values %bitvector_for_carrier_location );
    
    # Default return values
    my ( @linked_fliers, @tentatively_linked_fliers );
    
    # Optional return values
    my ( $linked_fliers_bv,
         $tentatively_linked_fliers_bv )
        = Bit::Vector->new( $x_tiles*$y_tiles, 2 );
    
    # Now we're ready to check which fliers are within
    # the airspace of our carrier of interest
    FLIER_BITVECTOR:
    foreach my $flier_location (
        keys %bitvector_for_flier_location ) {
        
        my ( $flier_tile_id, $flier_index ) =
            split m{\.}, $flier_location, 2;
        my $flier_bitvector =
            $bitvector_for_flier_location{
                $flier_location };
        
        # Docked fliers are exceptions.  A flier that
        # is docked at the carrier of interest
        # is, by definition, automatically linked to
        # it.  Likewise, a flier that is docked
        # at another carrier is automatically unlinked
        # to the carrier of interest (it isn't
        # even considered "tentatively linked").
        my $flier_dock =
            $self->{ 'dock-cache' }->{
                "$flier_tile_id.$flier_index" };
        
        if ( defined $flier_dock ) {
            # flier is docked, somewhere
            
            if ( $flier_dock eq "$carrier_tile_id.$carrier_index" ) {
                my $flier_tile_name =
                    $self->convert( $flier_tile_id, 'tile' );
                
                $flier_location = ( $flier_index == 0 )
                    ? $flier_tile_name
                    : "$flier_tile_name.$flier_index";
                
                # automatically linked
                push @linked_fliers, $flier_location;
                $linked_fliers_bv->Bit_On( $flier_tile_id );
            }
            
            # Note that we automatically ignore fliers
            # linked to other carriers
            next FLIER_BITVECTOR;
        }
        
        # The remaining fliers may exist in one or more
        # airspaces.  We now check the airspace count,
        # which will determine whether each flier is
        # definitely linked or tentatively linked.
        my $test_vec = Bit::Vector->new( $x_tiles*$y_tiles );
        $test_vec->And( $carrier_bitvector, $flier_bitvector );
        
        # We only care about fliers within the airspace
        # of the carrier of interest.
        next FLIER_BITVECTOR if ( $test_vec->to_Bin() == 0 );
        
        my $carrier_count =
            $self->get_carrier_indices_containing_tile(
                $flier_tile_id, @carrier_bitvectors );
        
        my $flier_tile_name = $self->convert(
            $flier_tile_id, 'tile' );
        
        $flier_location = ( $flier_index == 0 ) ? $flier_tile_name
            : "$flier_tile_name.$flier_index";
        
        if ( $carrier_count == 0 ) {
            push @linked_fliers, $flier_location;
            $linked_fliers_bv->Bit_On( $flier_tile_id );
        }
        else {
            push @tentatively_linked_fliers, $flier_location;
            $tentatively_linked_fliers_bv->Bit_On(
                $flier_tile_id );
        }
    }
    
    ( $return_bitvectors )
        ? return $linked_fliers_bv, $tentatively_linked_fliers_bv
            : return \@linked_fliers, \@tentatively_linked_fliers;
}

=head2 legal_actions( $tile, $index )

 Purpose: Returns all legal moves that are available to the
          gamepiece located at $tile and $index.
 Returns: @legal_moves
 Throws: none
 Comment: Rotation options are NOT included in the
          legal moves array.

=cut

sub legal_actions {
   my $self = shift;
   calculate_actions( $self, @_ );
   return @{ $self->{'legal-actions-cache'} };
}

=head2 illegal_actions( $tile, $index )

 Purpose: Returns all moves that are unavailable to the
          gamepiece located at $tile and $index.
 Returns: @illegal_moves
 Throws: none
 Comment: Rotation options are NOT included in the
          illegal moves array.

=cut

sub illegal_actions {
   my $self = shift;
   calculate_actions( $self, @_ );
   return @{ $self->{'illegal-actions-cache'} };
}

=head2 proxy_movement_space( $tile, $index )

 Purpose: Returns all tiles that define a restricted
          movement space for the gamepiece located at
          $tile and $index.
 Returns: @movement_space
 Throws: none

=cut

sub proxy_movement_space {
   my $self = shift;
   calculate_actions( $self, @_ );
   return @{ $self->{'movement-space-cache'} };
}

## calculate_actions( $tile, $index )
#
# Purpose: Calculate all actions (legal and illegal) and proxy
#          movement space for the gamepiece located at $tile
#          and $index.
# Returns:
# Throws: Dies if gamepiece does not exist at $tile and $index.
# Comments: Intended for internal use only.  Casual developers
#           should use legal_actions(), illegal_actions(), and
#           proxy_movement_space() instead.

sub calculate_actions {
   my ( $self, $tile, $index ) = @_;
   my $cache_id = "$tile.$index";
   return if ( $self->{'actions-cache-for'} eq $cache_id );
   
   # Before we do anything, we have to make sure that
   # all flier locations are accounted for at the
   # beginning of the game:
   # after gamepieces have been added, but before
   # any actions have been placed.
   $self->update_flier_location_bitvectors()
       if ( !@{ $self->{'flier-location-bitvectors'} } );

   my @legal_actions;
   my @illegal_actions;
   
   # Factor out board info
   my $tile_id = $self->convert( $tile, 'id' );
   my ( $x_tiles, $y_tiles ) = ( $self->x_tiles(), $self->y_tiles() );
   
   # Factor out game piece info
   my ( $gamepiece, $team, $direction )
       = $self->get_tile_contents_for_index(
           $tile, $index, 'gamepiece', 'team', 'direction' );

   my @move_vectors = $gamepiece->move_vectors();
   my @shot_vectors = $gamepiece->shot_vectors();  
   my $is_flying = $gamepiece->is_flying();
   my $can_rotate = $gamepiece->can_rotate();
   
   die "Gamepiece does not exist at tile [$tile] index [$index].\n"
       if ( !defined $gamepiece );
   
   # Collect movement space for unit
   my $movement_bitfield = $self->get_movement_space(
      $gamepiece, $team, $tile_id );
   
   # Collect arrays of linked units
   my ( $links_ref, $tentative_links_ref )
       = $self->get_fliers_linked_to_carrier( $tile_id, $index );
   my $has_links =
       ( @{ $links_ref } || @{ $tentative_links_ref } );
   
   # Human-readable rules
   my %can_capture = map { $_ => 1 } (
      #'ground-vs-friendly-ground',
      'ground-vs-enemy-ground',
      #'ground-vs-friendly-air',
      #'ground-vs-enemy-air',
      #'air-vs-friendly-ground',
      #'air-vs-friendly-air',
      'air-vs-enemy-ground',
      'air-vs-enemy-air',
      );
   my %can_move = map { $_ => 1 } (
      #'ground-vs-friendly-ground',
      'ground-vs-friendly-air',
      #'ground-vs-enemy-ground',
      'ground-vs-enemy-air',
      'air-vs-friendly-ground',
      'air-vs-friendly-air',
      'air-vs-enemy-ground',
      #'air-vs-enemy-air',
      );
   my %TRANSFORM_FOR_ROTATION = (
       'n' => sub { return @_ },
       'e' => sub { return (  $_[1], -$_[0], $_[2] ) },
       's' => sub { return ( -$_[0], -$_[1], $_[2] ) },
       'w' => sub { return ( -$_[1],  $_[0], $_[2] ) },
      );

   my $on_the_spot_done = 0;
   
   MOVE_VECTOR:
   foreach my $vector ( @move_vectors ) {
      # Factor out vector components, after transforming
      # for direction
      my ( $x_move, $y_move, $max_step )
          = $TRANSFORM_FOR_ROTATION{
              $direction }->( @{ $vector } );

      my $offset = $x_tiles*$y_move + $x_move;
      # Tile that we are currently analysing
      my $current_tile_id = $tile_id;
      my $can_pass_through = 1;

      STEP:
      for ( my $step = 0; $step <= $max_step; $step++ ) {

         # The first step is "on-the-spot".  Naturally,
         # this only applies to units that are allowed
         # to rotate.
         next STEP if ( $step == 0 && !$can_rotate );

         # Also, we only want to run through the
         # "on-the-spot" calculation once.
         if ( $step == 0 and $on_the_spot_done ) {
             next STEP;
         }
         $on_the_spot_done = 1;

         my $new_tile_id = $tile_id + $offset * $step;

         next MOVE_VECTOR if boundary_crossed(
            $current_tile_id, $new_tile_id, $x_tiles, $y_tiles );

         # Prepare for next step
         $current_tile_id = $new_tile_id;

         if ( !$movement_bitfield->bit_test( $current_tile_id ) ) {
            # This prevents out-of-bounds squares from appearing
            # even in the @illegal_moves array
            next MOVE_VECTOR;
         }

         my $can_capture = undef;
         my @air_captures;

         my ( $new_pieces, $new_teams ) = $self->get_tile_contents(
            $new_tile_id, 'gamepieces', 'teams' );

         my $new_tile = $self->convert( $new_tile_id, 'tile' );

         if ( $can_pass_through ) {
            for ( my $j = 0; $j < ( @{ $new_pieces } ); $j++ ) {

               # Factor out game piece info
               my ( $other_gamepiece, $other_team )
                  = $self->get_tile_contents_for_index(
                  $new_tile_id, $j, 'gamepiece', 'team' );

               my $key = $is_flying ? 'air-vs' : 'ground-vs';
               $key .= ( $team == $other_team )
                   ? '-friendly' : '-enemy';
               $key .= ( $other_gamepiece->is_flying() )
                  ? '-air' : '-ground';
               
               $can_pass_through = 0 if ( !$can_move{$key} );

               if ( $can_capture{$key} ) {
                   # Separate air vs ground captures while
                   # remembering that docked air units are
                   # considered grounded.
                   # Notice that grounded fliers are
                   # completely ignored.
                   if ( $other_gamepiece->is_flying() &&
                            !defined $self->{'dock-cache'}->{
                                "$new_tile_id.$j"} ) {
                       push @air_captures, $j;
                   }
                   elsif ( !$other_gamepiece->is_flying() ) {
                       $can_capture = [ $j ];
                   }

                   # There's a subtlety here that we have to
                   # catch.  If the enemy flier is docked, we
                   # actually CAN move to this tile without
                   # capturing anything.
                   if ( $other_gamepiece->is_flying() &&
                            defined $self->{'dock-cache'}->{
                                "$new_tile_id.$j"} ) {
                       $can_pass_through = 1;
                   }
               }

            }
         }

         # Air units must be captured before ground units.
         if ( @air_captures ) {
             $can_capture = \@air_captures;
         }

         # Calculate possible rotations and store in a
         # hashref.
         # This will either be undef (see below), or store:
         # { 'n' => [$tentative1, $tentative2], ... }
         my $direction_allowance = +{};
         if ( $can_rotate ) {
             foreach ( 'n', 'e', 's', 'w' ) {
                 # Turning 360 degrees on the spot is illegal
                 next if ( $tile eq $new_tile
                        && $_ eq $direction );
                 $direction_allowance->{$_} = {};
             }
         }
         else {
             $direction_allowance->{$direction} = {};
         }
         
         if ( $has_links && ( defined $can_pass_through
              || defined $can_capture ) ) {
             
             # TODO: Clean up this function call
             # Also, do we care that only $can_capture->[0]
             # is considered?  I don't.
             $self->calculate_link_destinations(
                 $links_ref, $tentative_links_ref,
                 $offset, $step, $team, $direction,
                 $new_tile_id, $can_capture->[0],
                 $direction_allowance );
             
             # If $direction_allowance is empty then all
             # moves are illegal.  Advance to next step.
             next STEP if ( !%{ $direction_allowance } );
         }
         
         my @possible_directions = ( $can_rotate )
             ? ( keys %{ $direction_allowance } )
                 : ( $direction );
         
         if ( $can_pass_through ) {
            my $action = ChessLike::Action->new(
               'tile' => $tile,
               'index' => $index,
               'type' => 'move',
               'target-tile' => $new_tile,
               'target-index' => -1,
               'direction' => undef,
               'possible-directions' => \@possible_directions,
               'links' => $links_ref,
               'possible-links' => $tentative_links_ref,
               'link-destinations' => $direction_allowance,
               );
            push @legal_actions, $action;
         }
         
         if ( defined $can_capture ) {
            foreach my $capture_index ( @{ $can_capture } ) {
                my $action = ChessLike::Action->new(
                    'tile' => $tile,
                    'index' => $index,
                    'type' => 'capture',
                    'target-tile' => $new_tile,
                    'target-index' => $capture_index,
                    'direction' => undef,
                    'possible-directions' => \@possible_directions,
                    'links' => $links_ref,
                    'possible-links' => $tentative_links_ref,
                    'link-destinations' => $direction_allowance,
                );
                push @legal_actions, $action;
            }
         }
         
         if ( !$can_pass_through && !defined $can_capture
                  && $step > 0 ) {
             
            my $action = ChessLike::Action->new(
               'tile' => $tile,
               'index' => $index,
               'type' => 'move',
               'target-tile' => $new_tile,
               'target-index' => -1,
               'direction' => undef,
               'links' => $links_ref,
               'possible-links' => $tentative_links_ref,
               'link-destinations' => $direction_allowance,
               );
            push @illegal_actions, $action;
         }
         
         if ( $step == 0 && $can_rotate ) {
             # Game piece is allowed to rotate on the spot
             my $action = ChessLike::Action->new(
                 'tile' => $tile,
                 'index' => $index,
                 'type' => 'rotation',
                 'target-tile' => $index,
                 'target-index' => -1,
                 'direction' => undef,
                 'possible-directions' => \@possible_directions,
                 'links' => $links_ref,
                 'possible-links' => $tentative_links_ref,
                 'link-destinations' => $direction_allowance,
             );
             push @legal_actions, $action;
             
             # This exception is necessary to allow $step to
             # increase past 0 after "on-the-spot" rotation
             # has been calculated.
             $can_pass_through = 1;
         }
         
      }
   }

   SHOT_VECTOR:
   foreach my $vector ( @shot_vectors ) {
      # Factor out vector components, after transforming
      # for direction
      my ( $x_move, $y_move, $max_step )
          = $TRANSFORM_FOR_ROTATION{ $direction }->( @{ $vector } );

      my $offset = $x_tiles*$y_move + $x_move;
      # Tile that we are currently analysing
      my $current_tile_id = $tile_id;

      for ( my $step = 1; $step <= $max_step; $step++ ) {
         my $new_tile_id = $tile_id + $offset * $step;
         my $can_target = 0;
         
         # Skip remaining tiles if a boundary has been reached
         next SHOT_VECTOR if boundary_crossed(
            $current_tile_id, $new_tile_id, $x_tiles, $y_tiles );
         
         $current_tile_id = $new_tile_id;  # Prepare for next step

         my ( $new_pieces, $new_teams ) = $self->get_tile_contents(
            $new_tile_id, 'gamepieces', 'teams' );

         my $new_tile = $self->convert( $new_tile_id, 'tile' );

         for ( my $j = 0; $j < ( @{ $new_pieces } ); $j++ ) {
            # Factor out game piece info
            my $other_team = $self->get_tile_contents_for_index(
               $new_tile_id, $j, 'team' );

            if ( $team != $other_team ) {
               my $action = ChessLike::Action->new(
                  'tile' => $tile,
                  'index' => $index,
                  'type' => 'shot',
                  'target-tile' => $new_tile,
                  'target-index' => $j,
                  'direction' => undef,
                  'links' => $links_ref,
                  'possible-links' => $tentative_links_ref,
                  );
               push @legal_actions, $action;
               $can_target = 1;
            }
         }
         
         if ( !$can_target ) {
            my $action = ChessLike::Action->new(
               'tile' => $tile,
               'index' => $index,
               'type' => 'shot',
               'target-tile' => $new_tile,
               'target-index' => 0,
               'direction' => undef,
               'links' => $links_ref,
               'possible-links' => $tentative_links_ref,
               );
            push @illegal_actions, $action;
         }
      }
   }

   $self->{'legal-actions-cache'}   = \@legal_actions;
   $self->{'illegal-actions-cache'} = \@illegal_actions;
   $self->{'actions-cache-for'}     = $cache_id;

   #### boundary_crossed( $tile_id, $new_tile_id, $x_tiles, $y_tiles )
   ##
   ## Purpose: Determine if the vector from $tile_id to
   ##          $new_tile_id crosses a board boundary.
   ## Returns: 0 or 1
   ## Throws: none
    ## Comments: Intended for internal use by ChessLike::Board::calculate_actions().

   sub boundary_crossed {
      my ( $current_tile_id, $new_tile_id, $x_tiles,
           $y_tiles ) = @_;

      # Edge-column is used to determine whether or not we are
      # trying to move through the east/west board boundaries.
      # We assign a value of 0 if west-edge, (X-TILES - 1) if
      # east-edge, and -1 otherwise.  If the edge_column value
      # before and after a move equals exactly (X-TILES - 1),
      # then we know the move crosses the board boundary, and
      # is therefore illegal.
      my $edge_column = ( $current_tile_id % $x_tiles == 0
         || ($current_tile_id + 1) % $x_tiles == 0 )
         ? $current_tile_id % $x_tiles : -1;

      # Skip remaining tiles if a boundary has been reached
      return 1 if ( $new_tile_id > ( $x_tiles * $y_tiles - 1 )
         || $new_tile_id < 0 );
      return 1 if ( $new_tile_id % $x_tiles
         + $edge_column == ( $x_tiles - 1 ) );

      return 0;
   }
}

## calculate_link_destinations( \@links, \@possible_links,
#     $offset, $step, $team, $direction, $carrier_tile_id,
#     $capture_index, $direction_allowance )
#
# Purpose: Writes link destinations, keyed by target carrier direction,
#          to $direction_allowance.  Deletes any directions that have
#          illegal moves, therefore it creates an empty hashref if
#          no moves are available.
# Returns: 1
# Throws: none
# Comments: For example,
#   $direction_allowance = { 'n' => { 'a1.2' => 'a2',
#                                     'b2.0' => 'b3' },
#                            'e' => { 'a1.2' => 'b2' } }

sub calculate_link_destinations {
    my ( $self, $links_ref, $tentative_links_ref,
         $offset, $step, $team, $direction,
         $carrier_tile_id, $capture_index,
         $direction_allowance ) = @_;
    
    my ( $x_tiles, $y_tiles )
        = ( $self->x_tiles(), $self->y_tiles() );
    my ( $carrier_x, $carrier_y ) = split m{,},
        $self->convert( $carrier_tile_id, 'xy' );
    my $old_carrier_tile_id = $carrier_tile_id - $offset*$step;
    my ( $old_carrier_x, $old_carrier_y ) = split m{,},
        $self->convert( $old_carrier_tile_id, 'xy' );
    
    # Remember, player 1 is index 0 and player2 is index 1
    my $enemy_flier_location_bitvector = ( $team == 1 )
        ? $self->{'flier-location-bitvectors'}->[1]
            : $self->{'flier-location-bitvectors'}->[0];
    
    # There is one exception that we need to deal with:
    # p1 moves to capture a p2 carrier, causing a p1 flier
    # to move onto a p2 flier that is killed as a result
    # of the capture move.
    # We handle this by checking to see if the captured
    # unit (if any) has any linked-units, and then we grab
    # the bitvector representation of their locations.
    # By inverting the bitvector (via "Not()"), and
    # performaing a bitwise And, we can remove this
    # bitvector from $enemy_flier_location_bitvector.
    if ( defined $capture_index ) {
        my ( $captured_links_bv, $uncaptured_links_bv )
            = $self->get_fliers_linked_to_carrier(
                $carrier_tile_id, $capture_index, 1 );
        
        if ( defined $captured_links_bv ) {
            $captured_links_bv->Not( $captured_links_bv );
            $enemy_flier_location_bitvector->And(
                $enemy_flier_location_bitvector,
                $captured_links_bv );
        }
    }
    
    my %TO_NORTH = (
        'n' => sub { return @_ },
        'e' => sub { return -$_[1], $_[0] },
        's' => sub { return -$_[0], -$_[1] },
        'w' => sub { return $_[1], -$_[0] },
    );
    my %FROM_NORTH = (
        'n' => sub { return @_ },
        'e' => sub { return $_[1], -$_[0] },
        's' => sub { return -$_[0], -$_[1] },
        'w' => sub { return -$_[1], $_[0] },
    );

    my $n_definite_links = @{ $links_ref };
    my $i = 0;
    foreach my $link ( @{ $links_ref },
                       @{ $tentative_links_ref } ) {
        
        my ( $link_tile, $link_index ) = split m{\.}, $link, 2;
        $link_index = 0 if ( !defined $link_index );
        my ( $start_link_x, $start_link_y ) = split m{,},
            $self->convert( $link_tile, 'xy' ), 2;
        
        my $link_unrotated_dx = $start_link_x - $old_carrier_x;
        my $link_unrotated_dy = $start_link_y - $old_carrier_y;
        my $is_definitely_linked = $i < $n_definite_links
            ? 1 : 0;
        $i++;
        
        TEST_DIRECTION:
        foreach my $test_direction (
            keys %{ $direction_allowance } ) {
            
            my @temp_coords = $TO_NORTH{ $direction }->(
                $link_unrotated_dx, $link_unrotated_dy );
            my ( $new_link_dx, $new_link_dy ) = $FROM_NORTH{
                $test_direction }->( @temp_coords );
            my $new_link_x = $new_link_dx + $carrier_x;
            my $new_link_y = $new_link_dy + $carrier_y;
            
            # Enforce the N/S boundaries
            if ( $new_link_y < 1 ) {
                $new_link_y = 1;
            }
            elsif ( $new_link_y > $y_tiles ) {
                $new_link_y = $y_tiles;
            }
            
            # Enforce the E/W boundaries
            if ( $new_link_x < 1  ) {
                $new_link_x = 1;
            }
            elsif ( $new_link_x > $x_tiles ) {
                $new_link_x = $x_tiles;
            }
            
            my $link_target_tile_id = $self->convert(
                "$new_link_x, $new_link_y", 'id' );
            my $new_link_tile = $self->convert(
                $link_target_tile_id, 'tile' );
            
            if ( $enemy_flier_location_bitvector->bit_test(
                $link_target_tile_id ) ) {
                
                # Illegal move
                if ( $is_definitely_linked ) {
                    # Illegal direction, period
                    delete $direction_allowance->{
                        $test_direction };
                    next TEST_DIRECTION;
                }
            }
            else {
                $direction_allowance->{$test_direction}->{$link}
                    = $new_link_tile;
            }
        } # end TEST_DIRECTION
        
    } # end foreach link
    
    return 1;
}

## get_movement_space( $gamepiece, $team, $tile )
#
# Purpose: Collect an bit vector of allowed tile IDs for movement
# Returns: $movement_bitvector
# Throws: none
# Comment: Intended for internal use only.

sub get_movement_space {
   my ( $self, $gamepiece, $team, $gamepiece_tile ) = @_;
   my $carrier_name = $gamepiece->requires_units();

   my $proxy_bitspace;  # Will contain final movement space

   # Factor out board info
   my $gamepiece_tile_id = $self->convert( $gamepiece_tile, 'id' );
   my ( $x_tiles, $y_tiles ) = ( $self->x_tiles(), $self->y_tiles() );

   # Return a filled bitvector if unit is not tied to a carrier-type
   if ( !defined $carrier_name ) {
      $proxy_bitspace = Bit::Vector->new( $x_tiles*$y_tiles );
      $proxy_bitspace->Fill();
      $self->{'movement-space-cache'} = [];
      return $proxy_bitspace;
   }

   my %bitfield_for_carrier_location
      = %{ $self->{'carrier-cache'}->{"$carrier_name-$team"} };

   # This will contain final movement space in tile notation
   my @proxy_space = ();
   # List of proxy fields for all carriers
   my @carrier_bitfields;

   # First things first.  We keep track of the proxy space
   # for every carrier in an array or arrayrefs structure.
   foreach my $carrier_bitfield (
       values %bitfield_for_carrier_location ) {

       push @carrier_bitfields, $carrier_bitfield;
   }

   my @fields_containing_gamepiece
       = $self->get_carrier_indices_containing_tile(
           $gamepiece_tile_id, @carrier_bitfields );

   # In the event that the gamepiece is out-of-bounds, we
   # return a bitspace full of zeros.  Note the distinction
   # between this return value, and the return value for
   # units without a carrier: a filled bitvector.
   if ( @fields_containing_gamepiece == 0 ) {
      $proxy_bitspace = Bit::Vector->new( $x_tiles*$y_tiles );
      $self->{'movement-space-cache'} = [];
      return $proxy_bitspace;
   }

   # We know which proxy field contains our gamepiece.
   # Now we have to determine whether any of the other
   # proxy fields overlap (either directly or indirectly)
   # with that field.
   # Oh, and note that we Clone() the bitvector, since
   # we don't want to modify the original.
   $proxy_bitspace = splice( @carrier_bitfields,
      $fields_containing_gamepiece[-1], 1 )->Clone();

   my $merged = 1;

   while ( $merged ) {
      $merged = 0;

      for ( my $i = 0; $i < @carrier_bitfields; $i++ ) {
         my $test_vec = Bit::Vector->new( $x_tiles*$y_tiles );
         $test_vec->And( $proxy_bitspace, $carrier_bitfields[$i] );
         my $test_string = $test_vec->to_Bin();

         if ( $test_string != 0 ) {
            $proxy_bitspace->Or( $proxy_bitspace,
                                 $carrier_bitfields[$i] );
            splice( @carrier_bitfields, $i, 1 );
            $merged = 1;
         }
      }
   }

   # Of course, bitfields are a poor format choice for simple API
   # access, so we cache an array of tiles for external use.
   for ( my $i = 0; $i < $x_tiles*$y_tiles; $i++ ) {
      if ( $proxy_bitspace->bit_test( $i ) ) {
         my $tile = $self->convert( $i, 'tile' );
         push @proxy_space, $tile;
      }
   }
   $self->{'movement-space-cache'} = \@proxy_space;

   return $proxy_bitspace;
}

=head2 dump()

 Purpose: Prints all board contents to STDOUT.
 Returns: none
 Throws: none
 Comment: Intended for debugging purposes.

=cut

sub dump {
   my $self = shift;
   
   my $x_tiles = $self->x_tiles();
   my $y_tiles = $self->y_tiles();
   
   print "Board dimensions: $x_tiles x $y_tiles\n";
   
   my %element_for_index = (
      0 => 'gamepiece',
      1 => 'team',
      2 => 'direction',
      3 => 'graphic',
      );

   for ( my $y = 1; $y <= $y_tiles; $y++ ) {
      for ( my $x = 1; $x <= $x_tiles; $x++ ) {
        
        my @tile_contents = $self->get_tile_contents( "$x, $y",
         'gamepieces', 'teams', 'directions', 'graphics' );
         
        print "[$x, $y]";
        
        for ( my $i = 0; $i < @tile_contents; $i++ ) {
            my @array = @{ $tile_contents[$i] };
            
            print ' '.$element_for_index{$i}.'[';

            foreach ( @array ) {
                if ( $i == 0 ) {
                    ( defined )
                        ? print '<' . $_->name() . '>'
                            : print "<undef>";
                }
                else {
                    ( defined )
                        ? print "<$_>"
                            : print "<undef>";
                }
            }

            print ']';
        }
        
        print "\n";
      }
   }

   print "Movement Space Cache:\n";
   my $proxy_space_ref = $self->{'movement-space-cache'};
   if ( defined $proxy_space_ref ) {
      foreach my $tile ( @{ $proxy_space_ref } ) {
         print "\t$tile\n";
      }
      print "\n";
   }
   else {
      print "\tnone\n";
   }
}

=head2 dump_bv( $bitvector )

 Purpose: Prints a visual representation of a bitvector
          to STDOUT.
 Returns: none
 Throws: none
 Comment: Intended for debugging purposes.

=cut

sub dump_bv {
   my ( $self, $bitvector ) = @_;
   my ( $x_tiles, $y_tiles ) = ( $self->x_tiles(),
                                 $self->y_tiles() );
   
   my $str = '';
   for ( my $j = ( $x_tiles*$y_tiles - 1 );
         $j >= 0; $j-- ) {
       
       if ( $bitvector->bit_test( $j ) ) {
           $str = "X" . $str;
       } else {
           $str = "-" . $str;
       }
       if ( $j % $x_tiles == 0 ) {
           print "$str\n";
           $str = '';
       }
   }
   
   print "$str\n";
}

=head2 convert( $coords, $format )

 Purpose: Converts $coords between board coordinates.
          Supported formats are `tile', `id', and `xy'.
 Returns: $converted_coords
 Throws: Dies if $coords is undefined
         Dies if $format is undefined
         Dies if $coords string format is unrecognized
         Dies if $format string format is unrecognized

=cut

sub convert {
   my ( $self, $from, $to ) = @_;
   
   die "Error: Missing conversion string in ChessLike::Board::convert()"
      if ( !defined $from );
   die "Error: Missing conversion format in ChessLike::Board::convert()"
      if ( !defined $to );

   # TODO: id supports negative numbers (necessary for calculating
   # linked-unit rotations).  xy supports this too, cause it's
   # trivial.  Standard chess notation (ie, tile) does not.
   my %regex_for_format = (
      'tile' => qr(\A([a-z]+)(\d+)\z),
      'id'   => qr(\A(-?\d+)\z),
      'xy'   => qr(\A(-?\d+),\s*(-?\d+)\z),
      );
   my %parser_for_format = (
      'tile' => sub {
            my ( $m1, $m2 ) = @_;
            my %number_for_letter;
            @number_for_letter{ 'a'..'z' } = ( 1..26 );
            return $number_for_letter{$m1}, $m2;
         },
      'id'   => sub {
            my $m1 = shift;
            my $x_tiles = $self->x_tiles();
            return ( $m1 % $x_tiles + 1 ),
                ( int( $m1 / $x_tiles ) + 1 );
         },
      'xy'   => sub {
            return @_;
         },
      );
   my ( $x, $y );
   
   foreach my $format ( keys %regex_for_format ) {
      if ( my ( $m1, $m2 )
               = ( $from =~ $regex_for_format{$format} ) ) {

          ( $x, $y ) = $parser_for_format{$format}->( $m1, $m2 );
      }
   }
   
   die "Error: Format of [$from] not recognized!\n"
       if ( !defined $x );
   
   my %conversion_for_format = (
      'tile' => sub {
            my ( $x, $y ) = @_;
            my %letter_for_number;
            @letter_for_number{ 1..26 } = ( 'a'..'z' );
            return $letter_for_number{$x}.$y;
         },
      'id'   => sub {
            my ( $x, $y ) = @_;
            my $x_tiles = $self->x_tiles();
            return $x_tiles * ( $y - 1 ) + ( $x - 1 );
         },
      'xy'   => sub {
            my ( $x, $y ) = @_;
            return "$x,$y";
         },
      'bitvector' => sub {
            my ( $x, $y ) = @_;
            my ( $x_tiles, $y_tiles ) = ( $self->x_tiles(),
                                          $self->y_tiles() );
            my $bitvector = Bit::Vector->new( $x_tiles*$y_tiles );
            my $tile_id = $x_tiles * ( $y - 1 ) + ( $x - 1 );
            $bitvector->Bit_On( $tile_id );
            return $bitvector;
         },
      );
      
   die "Error: Format $to not recognized!\n"
      if ( !defined $conversion_for_format{$to} );
   
   return $conversion_for_format{$to}->( $x, $y );
}

=head2 apply_action( $action )

 Purpose: Applies the results of the action to the game board, and
          returns a comprehensive array of the changs made.
 Returns: @results
 Throws: Dies if action is not legal.
 Comment: For example,
      @results = ( [ 'rotate', 'b2', 1, 'e' ],
                   [ 'remove', 'b2', 1 ],
                   [ 'move', 'a1', 0, b2, 1 ] )
 Comment: A rotation is written as
    [ 'rotate', tile, index, direction ]
          Game piece removal is written as
    [ 'remove', tile, index ]
          Game piece relocation is written as
    [ 'move', start-tile, start-index, target-tile, target-index ]

=cut

sub apply_action {
    my ( $self, $action ) = @_;
    my $type = $action->type();
    my $tile = $action->tile();
    my $target_tile = $action->target_tile();
    my $index = $action->index();
    my $target_index = $action->target_index();
    my @links = $action->links();
    my $direction = $action->direction();
    
    my $action_string = $action->to_string( 1 );
    my @legal_actions = $self->legal_actions( $tile, $index );
    my ( $gamepiece, $start_direction, $team )
        = $self->get_tile_contents_for_index(
            $tile, $index, 'gamepiece',
            'direction', 'team' );
    
    my ( $x_tiles, $y_tiles )
        = ( $self->x_tiles(), $self->y_tiles() );
    
    # Our return value (unless the method dies).  Stores a
    # list of changes that occur as a result of the action.
    # Intended to be used by GUIs to update the graphical
    # view of the board.
    # example value:
    #  ( [ 'rotate', 'b2', 1, 'e' ],
    #    [ 'remove', 'b2', 1 ],
    #    [ 'move', 'a1', 0, b2, 1 ] )
    my @results;
    
    # This next hash is necessary when configuring multiple
    # units within a single action (ie, when moving linked
    # units).  Each hash value is an arrayref containing a
    # list of index-adjustment value pairs.  For example:
    #   a2.1 moves to b2.0
    #   hash: 'a2' => [ '2.-1' ], 'b2' => [ '0.1' ]
    #   a2.2 is killed
    #   a2.2 is adjusted by -1 because it has an index >= 2,
    #     and thus is corrected to a2.1.  It is then removed.
    #   hash: 'a2' => [ '2.-1', '2.-1' ], 'b2' => [ '0.1' ]
    #
    # This system has some obvious deficiencies.  First, if
    # a unit is moved, it can't then be moved again within
    # the same action (its index will be incorrectly adjusted).
    # However, since this breaks every known chess rule that
    # I'm aware of, someone else can deal with it.
    #
    # I also don't take into account links that themselves
    # have links, or properly account for link movement if
    # the link is expected to move >1 tile and run into a
    # boundary.  These are low priority though, and may never
    # be fixed unless a ruleset demands it.
    my %index_adjustment_for_tile;
    
    # Check if action is legal.
    # We go through every single exception BEFORE we start
    # modifying the board.  That way we can bail out without
    # worrying about undo-ing any changes that we started
    # to apply.
    my $matched_action = 0;
    foreach my $legal_action ( @legal_actions ) {
        if ( $action_string eq $legal_action->to_string( 1 ) ) {
            $matched_action = $legal_action;
            last;
        }
    }
    die "Illegal action: Target tile is out-of-bounds.\n"
        if ( !$matched_action );
    
    # Check rotation against possible-directions
    my @possible_directions = $matched_action->possible_directions();
    my $ready_to_rotate = 0;
    
    if ( defined $direction ) {
        if ( $direction ne $start_direction ) {
            die "Illegal action: Gamepiece at [$tile.$index]"
                . " cannot rotate.\n"
                    if ( !$gamepiece->can_rotate() );
            
            die "Illegal action: Cannot shoot and rotate in"
                . " the same turn.\n" if ( $type eq 'shot' );
            
            $ready_to_rotate = 1;
        }
        
        die "Illegal action: Direction [$direction] is invalid.\n"
            unless ( grep m{$direction}, @possible_directions );
    }
    
    # Handle special on-spot rotation case
    if ( $type eq 'rotation' ) {
        die "Illegal action: Direction must be defined for"
            . " rotation actions.\n" if ( !defined $direction );
        
        die "Illegal action: Direction [$direction] is invalid.\n"
            unless ( grep m{$direction}, @possible_directions );
        
        $ready_to_rotate = 1;
    }
    
    # Validate link destinations
    foreach my $link ( sort @links ) {
        my $temp_direction = ( defined $direction )
            ? $direction : $start_direction;
        eval {
            my $link_target_tile
                = $action->link_destination(
                    $link, $temp_direction );
        };
        die $@ if $@;
    }
    
    # Collect lists of shared/unshared links and validate them
    # against $action links
    my ( $unshared_links_ref, $shared_links_ref )
        = $self->get_fliers_linked_to_carrier( $tile, $index );
    
    # All unshared links must be in links
    foreach my $test_link ( @{ $unshared_links_ref } ) {
        my @matches = grep { $_ eq $test_link } @links;
        die "Unshared unit [$test_link] is required, but"
            . " not linked.\n" unless ( @matches );
    }
    
    # All links must be in shared + unshared links
    foreach my $test_link ( @links ) {
        my @matches = grep { $_ eq $test_link }
            ( @{ $unshared_links_ref }, @{ $shared_links_ref } );
        die "Illegal action: Linked unit [$test_link] is not a"
            . " valid link for carrier at [$tile.$index]\n"
                unless ( @matches );
    }
    
    if ( $ready_to_rotate ) {
        # Every action that has a rotation component gets
        # their graphic rotated here
        my $graphic = $self->get_tile_contents_for_index(
            $tile, $index, 'graphic' );
        
        $self->{'rotate-graphic-hook'}->(
            'graphic' => $graphic,
            'target-direction' => $direction,
        );
        
        push @results, [ 'rotate', $tile, $index, $direction ];
        
        # Move/Capture actions with rotation components
        # get dealt with later, so we have to handle
        # pure rotation actions here
        if ( $type eq 'rotation' ) {
            $self->configure( $tile, $index, 'direction' => 'n' );

        }
    }
    
    # Remove captured/shot gamepieces, if necessary
    if ( $type eq 'capture' || $type eq 'shot' ) {
        
        # Grab target info
        my ( $target_links_ref, $rest )
            = $self->get_fliers_linked_to_carrier(
                $target_tile, $target_index );
        
        # Since this is the first possible step of any action,
        # we don't need to adjust the target-index
        my $target_graphic = $self->get_tile_contents_for_index(
            $target_tile, $target_index, 'graphic' );
        $self->{'delete-graphic-hook'}->(
            'graphic' => $target_graphic );
        $self->remove( $target_tile, $target_index );
        push @results, [ 'remove', $target_tile, $target_index ];
        
        # Record adjustment after removing target
        add_adjustment( \%index_adjustment_for_tile, $target_tile,
            $target_index, 'removed' );
        
        foreach my $target_link ( @{ $target_links_ref } ) {
            my ( $link_tile, $link_index )
                = split m{\.}, $target_link, 2;
            $link_index = 0 if ( !defined $link_index );
            
            # Adjust index
            $link_index = adjust_index( \%index_adjustment_for_tile,
               $link_tile, $link_index );
            
            # Destroy linked unit
            my $link_graphic = $self->get_tile_contents_for_index(
                $link_tile, $link_index, 'graphic' );
            $self->{'delete-graphic-hook'}->(
                'graphic' => $link_graphic );
            $self->remove( $link_tile, $link_index );
            push @results, [ 'remove', $link_tile, $link_index ];
            
            # Record adjustment
            add_adjustment( \%index_adjustment_for_tile, $link_tile,
                        $link_index, 'removed' );
        }
    }
    
    # Move current gamepiece, if necessary
    if ( $type eq 'move' || $type eq 'capture' ) {
        
        my $new_index = $self->move_unit(
            \%index_adjustment_for_tile, $tile, $index,
            $target_tile, $direction );
        push @results,
            [ 'move', $tile, $index, $target_tile, $new_index ];
        
        LINK_TO_MOVE:
        foreach my $link ( sort @links ) {
            # Remember: $action->direction() is allowed to
            # be undefined!
            my $temp_direction = ( defined $direction )
                ? $direction : $start_direction;
            my $link_target_tile = $action->link_destination(
                $link, $temp_direction );
            my ( $link_tile, $link_index ) = split m{\.}, $link, 2;
            $link_index = 0 if ( !defined $link_index );
            
            $new_index = $self->move_unit(
                \%index_adjustment_for_tile, $link_tile,
                $link_index, $link_target_tile, undef );
            push @results,
                [ 'move', $link_tile, $link_index,
                  $link_target_tile, $new_index ];
        }
    }
    
    # A lot has happened!  We'd better clear the cache to set up
    # for the next move.  Note that we do NOT have to make a call
    # to update_flier_location_bitvectors(), because this will
    # happen when we next call calculate_actions().
    
    ## TODO: Do what the previous comment says, and actually clear the cache.  Maybe re-work the cache as well, so that it keeps multiple moves in memory.
    
    return @results;
    
    #### add_adjustment( $hash_ref, $tile, $index, $mode )
    ##
    ## Purpose: Record an index adjustment at $tile due to board changes.
    ## Returns: 1
    ## Throws: none
    ## Comments: Intended for internal use by ChessLike::Board::apply_action().
    
    sub add_adjustment {
        my ( $hash_ref, $tile, $index, $mode ) = @_;
        my $value = 1;
        
        if ( $mode eq 'removed' ) {
            # A gamepiece was removed, so we only adjust indices
            # beyond this one.
            $index++;
            $value = -1;
        }
        
        push @{ $hash_ref->{$tile} }, [ $index, $value ];
        
        return 1;
    }
    
    #### adjust_index( $hash_ref, $tile, $index )
    ##
    ## Purpose: Adjust $index at $tile due to previous board changes
    ## Returns: $index
    ## Throws: none
    ## Comments: Intended for internal use by ChessLike::Board::apply_action().
    
    sub adjust_index {
        my ( $hash_ref, $tile, $index ) = @_;
        my $adjustment_list_ref = $hash_ref->{$tile};
        
        return $index if ( !defined $adjustment_list_ref );
        
        foreach my $adjustment_ref ( @{ $adjustment_list_ref } ) {
            my ( $correction_point, $value ) = @{ $adjustment_ref };
            
            if ( $index >= $correction_point ) {
                $index += $value;
            }
        }
        return $index;
    }
    
    #### move_unit( $hash_ref, $tile, $index, $target_tile, $rotation )
    ##
    ## Purpose: Safely moves a game piece on the board.
    ## Returns: $target_index
    ## Throws: none
    ## Comments: Intended for internal use by ChessLike::Board::apply_action().
    
    sub move_unit {
        my ( $self, $hash_ref, $unit_tile, $unit_index,
             $target_tile, $rotation ) = @_;
        
        # Adjust index
        $unit_index = adjust_index(
            $hash_ref, $unit_tile, $unit_index );
        
        # Grab unit info
        my ( $gamepiece, $team, $direction, $graphic )
            = $self->get_tile_contents_for_index(
                $unit_tile, $unit_index, 'gamepiece',
                'team', 'direction', 'graphic' );
        
        $direction = $rotation if ( defined $rotation );
        
        # Remove unit from starting tile
        $self->remove( $unit_tile, $unit_index );
        
        add_adjustment( $hash_ref, $unit_tile,
                        $unit_index, 'removed' );
        
        # Add unit to target tile
        my $new_unit_index = $self->add( $target_tile,
           'gamepiece' => $gamepiece,
           'team' => $team,
           'direction' => $direction,
           'graphic' => $graphic,
        );
        
        my ( $target_tile_x, $target_tile_y ) = split m{,},
            $self->convert( $target_tile, 'xy' );
        $self->{'move-graphic-hook'}->(
            'tile'           => $unit_tile,
            'target-tile'    => $target_tile,
            'target-tile-x'  => $target_tile_x,
            'target-tile-y'  => $target_tile_y,
            'target-index'   => $new_unit_index,
            'graphic' => $graphic,
        );
        
        add_adjustment( $hash_ref, $target_tile,
                        $new_unit_index, 'added' );
        
        return $new_unit_index;
    }

}

## update_flier_location_bitvectors
#
# Purpose: Creates flier-location-bitvectors for every
#          player, and stores them in $self.
# Returns: 1
# Throws: none

sub update_flier_location_bitvectors {
    my $self= shift;
    my ( $x_tiles, $y_tiles ) = ( $self->x_tiles(),
                                  $self->y_tiles() );
    
    my ( $p1_bitvector, $p2_bitvector )
        = Bit::Vector->new( $x_tiles*$y_tiles, 2 );
    
    FLIER_TYPE:
    foreach my $flier_type ( keys %{ $self->{'flier-cache'} } ) {
        my ( $name, $team ) = split m{-}, $flier_type, 2;
        # Remember, team 1 is index 0 and team 2 is index 1
        my $relevant_bitvector = ( $team == 1 )
            ? $p1_bitvector : $p2_bitvector;
        
        FLIER_LOCATION:
        foreach my $flier_location ( keys %{
            $self->{'flier-cache'}->{$flier_type} } ) {
            
            my ( $flier_tile_id, $flier_index )
                = split m{,}, $flier_location, 2;
            
            # Remember, docked fliers can't block other fliers!
            next FLIER_LOCATION if ( defined
                 $self->{'dock-cache'}->{$flier_location} );
            
            $relevant_bitvector->Bit_On( $flier_tile_id );
        }
    }
    
    $self->{'flier-location-bitvectors'} = [ $p1_bitvector,
                                         $p2_bitvector ];
    
    return 1;
}

=head1 AUTHOR

Michael J. Lewis, C<< <mjlewis at ualberta.net> >>

=head1 ACKNOWLEDGEMENTS

=head1 LICENSE AND COPYRIGHT

Copyright 2012 Michael J. Lewis.

This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.

See http://dev.perl.org/licenses/ for more information.

=cut

1; # End of ChessLike::Board
